;;########################################################################
;; logliplg.lsp
;; Copyright (c) 2000 by Pedro Valero
;; ViSta Plugin for Loglinear Analysis.
;; Adapted from Young's frequency plugin
;;########################################################################

;(require "vista")

; PLUGIN STEP 1: PLUGIN VARIABLE BINDINGS

(let ((menu-item-title "Log linear analysis")
      (tool-name "Loglin")
      (model-prefix "Lgl")
      (ok-data-types '("freqclass"));multivariate
      (ok-variable-types '(numeric category))
      (*loglin-plugin-path* (strcat *plugin-path* "lglin" *separator*))
      )

  (send *vista* :install-plugin tool-name menu-item-title ok-data-types)

  ;; PLUGIN STEP 2: PLUGIN CONSTRUCTOR FUNCTION
  
  (defun log-linear-analysis 
    (&key
     (data   *current-data*)
     (title  menu-item-title)
     (name   (strcat model-prefix "-" (send *current-data* :name)))
     (dialog nil))
    "Args: &key Function for loglinear analysis. Not to be confounded with log-linear-model that is the original loglinear function used to carry out the analyis"
    (let*
      (
      
    #|    (data-matrix (send data :convert-array2freqclass))
       (comp-data-matrix
        (mapcar #'(lambda (var) 
                    (setf data-matrix2 (sort-and-permute var data-matrix)))
                (reverse (select (column-list data-matrix) (iseq 1 (1- (array-dimension data-matrix 1)))))))
      (sort-key
         (mapcar #'(lambda (row) (apply 'strcat (combine row)))
                 (row-list (select data-matrix (iseq (array-dimension data-matrix 0)) 
                                  (iseq 1 (1- (array-dimension data-matrix 1)))))))
       (concat-category (mapcar #'(lambda (vv) (introduce-symbol (coerce vv 'list ))) 
                                (row-list (select data-matrix2 (iseq (array-dimension data-matrix2 0))
                                                  (iseq 1 (1- (array-dimension data-matrix2 1)))))))
        
       (concat-category 
        (sort-data 
         (mapcar #'(lambda (x) 
                     (apply 'strcat (car (coerce x 'list))
                            (mapcar #'(lambda (y) 
                                        (strcat "|" y )) 
                                    (cdr (coerce x 'list)))))
                 (row-list (select data-matrix 
                                   (iseq (array-dimension data-matrix 0)) 
                                   (iseq 1 (1- (array-dimension data-matrix 1))))))))
       (counts (coerce (first (column-list data-matrix2)) 'list))
       (level-labels (mapcar #'(lambda (col) (combine (remove-duplicates col)))
                             (select (column-list data-matrix2) 
                                     (iseq 1 (1- (array-dimension data-matrix2 1))))))
       ;(b (print level-labels))
       ;(a (print-matrix data-matrix2))
       (counts (combine (sort-and-permute
                         sort-key
                         (select data-matrix 
                                (iseq (array-dimension data-matrix 0))
                                0))))
       (counts-corrected (mapcar #'(lambda (ct) (if (= ct 0) 0.5 ct)) counts))
       (data-matrix (send data :active-data-matrix '(category)))
       (comp-data-matrix
        (mapcar #'(lambda (var) 
                    (setf data-matrix2 (sort-and-permute var data-matrix)))
                (reverse (select (column-list data-matrix) (iseq 1 (1- (array-dimension data-matrix 1)))))))
       (counts (coerce (first (column-list data-matrix)) 'list))
       (level-labels (mapcar #'sort-data (send data :active-array-labels)))
       (a (print-matrix data-matrix)) |#
       (level-labels (mapcar #'sort-data (send data :active-array-labels)))
       (sorted-level-labels (mapcar 'sort-data level-labels))
       (complete-data-matrix (send data :convert-array2freqclass))
       (data-matrix (apply 'bind-columns (col complete-data-matrix 
                                              (iseq 1 (- (array-dimension  complete-data-matrix 1)  1)))))
       (key (mapcar #'(lambda (x) 
                        (apply 'strcat (car (coerce x 'list))
                               (mapcar #'(lambda (y) 
                                           (strcat "|" y )) 
                                       (cdr (coerce x 'list)))))
                    (row-list (select data-matrix 
                                      (iseq (array-dimension data-matrix 0)) 
                                      (iseq (array-dimension data-matrix 1))))))
       (complete-data-matrix (sort-and-permute key complete-data-matrix ))
       (data-matrix (sort-and-permute  key data-matrix ))
       (counts (combine (col complete-data-matrix 0)))
       (concat-category
        (mapcar #'(lambda (vv) 
                    (introduce-symbol (coerce vv 'list ))) 
                (row-list (select data-matrix (iseq (array-dimension data-matrix 0))
                                  (iseq (array-dimension data-matrix 1))))))
       (ncat (mapcar '(lambda (var) (length var)) level-labels))
       (vars (send data :active-variables '(category)))
       (initial-model (if (> (length vars) 4) 
                          (mapcar #'(lambda (el) (list el))
                                  (iseq (length vars)))
                          (expand-hierarchy 
                           (list (iseq (length vars))))
                      ))
       (object (list (log-linear-model ncat counts initial-model vars  sorted-level-labels data-matrix)))
       )

      (send vista-loglinear-proto
            :new "Loglin" data title name nil object vars 
            ncat counts initial-model level-labels data-matrix concat-category)))
  (load (strcat *loglin-plugin-path* "loglin2.lsp"))
  (load (strcat *loglin-plugin-path* "loglin3.lsp"))
  (load (strcat *loglin-plugin-path* "loglin4.lsp"))
  (load (strcat *loglin-plugin-path* "loglin5.lsp"))
  (load (strcat *loglin-plugin-path* "my-print-matrix.lsp"))
   (load (strcat *loglin-plugin-path* "my-new-mp.lsp"))
  (load (strcat *loglin-plugin-path* "log-linear.lsp"))
  (load (strcat *loglin-plugin-path* "symbol-graph.lsp"))

  )



(provide "logliplg")
